home *** CD-ROM | disk | FTP | other *** search
- /* xlkmap - xlisp key map functions */
-
- #ifdef CI_86
- #include "a:stdio.h"
- #include "xlisp.h"
- #endif
-
- #ifdef AZTEC
- #include "a:stdio.h"
- #include "xlisp.h"
- #endif
-
- #ifdef unix
- #include <stdio.h>
- #include <xlisp.h>
- #endif
-
-
- /* external variables */
-
- extern struct node *xlstack;
- extern struct node *xlenv;
- extern struct node *self;
-
-
- /* local definitions */
-
- #define KMSIZE 256 /* number of characters in a keymap */
- #define KMAX 20 /* maximum number of characters in a key sequence */
- #define KEYMAP 0 /* instance variable number for 'keymap' */
-
-
- /* local variables */
-
- static struct node *currentenv;
-
-
- /* forward declarations (the extern hack is because of decusc) */
-
- extern struct node *sendmsg();
-
-
- /************************************
- * isnew - initialize a new keymap *
- ************************************/
-
- static struct node *isnew(args)
- struct node *args;
- {
- xllastarg(args); /* No arguments ! */
-
- /* Create a keymap node */
- xlivar(self->n_symvalue,KEYMAP)->n_listvalue = newnode(KMAP);
-
- return (self->n_symvalue); /* and return it */
- }
-
-
- /*******************************************************
- * newkmap - allocate memory for a new key map vector *
- *******************************************************/
-
- static struct node *(*newkmap())[]
- {
- struct node *(*map)[];
-
- /* allocate the vector */
- if ((map = (struct node *(*)[]) calloc(1,sizeof(struct node *) * KMSIZE))
- == NULL)
- {
- printf("insufficient memory");
- exit();
- }
-
- return (map); /* And return it */
- }
-
-
- /***********************
- * key - define a key *
- ***********************/
-
- static struct node *key(args)
- struct node *args;
- {
- struct node *oldstk,arg,kstr,ksym,*kmap,*kmptr;
- struct node *(*map)[];
- char *sptr;
- int ch;
-
- oldstk = xlsave(&arg,&kstr,&ksym,NULL); /* Create new stack frame */
- arg.n_ptr = args; /* initialize */
-
- kmap = xlivar(self->n_symvalue,KEYMAP)->n_listvalue; /* get keymap */
- if (kmap == NULL && kmap->n_type != KMAP)
- xlfail("bad keymap object");
-
- kstr.n_ptr = xlevmatch(STR,&arg.n_ptr); /* Find key string */
- ksym.n_ptr = xlevmatch(SYM,&arg.n_ptr); /* the the key symbol */
- xllastarg(arg.n_ptr); /* and make sure thats all */
-
- for (kmptr = kmap, sptr = kstr.n_ptr->n_str; /* process each char */
- *sptr != 0;
- kmptr = (*map)[ch])
- {
- ch = *sptr++; /* Get the character */
- if ((map = kmptr->n_kmap) == NULL) /* Allocate key map if reqd */
- map = kmptr->n_kmap = newkmap();
-
- if (*sptr == 0) /* End of string ? */
- (*map)[ch] = ksym.n_ptr;
- else
- if ((*map)[ch] == NULL || (*map)[ch]->n_type != KMAP)
- {
- (*map)[ch] = newnode(KMAP);
- (*map)[ch]->n_kmap = newkmap();
- }
- }
-
- xlstack = oldstk; /* Restore old stack frame */
- return (self->n_symvalue); /* and return keymap */
- }
-
-
- /*******************************************************
- * process - process input characters using a key map *
- *******************************************************/
-
- static struct node *process(args)
- struct node *args;
- {
- struct node *oldstk,arg,env,margs,*kmap,*kmptr,*nptr,*oldenv;
- struct node *(*map)[];
- char keys[KMAX+1];
- int ch,kndx;
-
- oldstk = xlsave(&arg,&env,&margs,NULL); /* create new stack frame */
- arg.n_ptr = args; /* Initialize */
-
- kmap = xlivar(self->n_symvalue,KEYMAP)->n_listvalue; /* Get keymap */
- if (kmap == NULL && kmap->n_type != KMAP)
- xlfail("bad keymap object");
-
- env.n_ptr = xlevmatch(LIST,&arg.n_ptr); /* Get the environment */
- xllastarg(arg.n_ptr); /* Ensure thats all */
-
- oldenv = xlenv; /* Bind the environment variable */
- xlbind(currentenv,env.n_ptr);
- xlfixbindings(oldenv);
-
- if (kmap->n_kmap == NULL) /* Ensure key map is defined */
- xlfail("empty keymap");
-
- margs.n_ptr = newnode(LIST); /* Create argument list */
- margs.n_ptr->n_listvalue = newnode(STR);
- margs.n_ptr->n_listvalue->n_str = keys;
- margs.n_ptr->n_listvalue->n_strtype = STATIC;
-
- for (kmptr = kmap, kndx = 0; TRUE; ) /* Character processing loop */
- {
- fflush(stdout); /* Flush pending output */
-
- if ((ch = kbin()) < 0) /* Get a character */
- break;
-
- if (kndx < KMAX) /* Put it is the key sequence */
- keys[kndx++] = ch;
- else
- xlfail("key sequence too long");
-
- if ((map = kmptr->n_kmap) == NULL) /* dispatch on character code */
- xlfail("bad keymap");
- else
- if ((nptr = (*map)[ch]) == NULL)
- {
- kmptr = kmap;
- kndx = 0;
- }
- else
- if (nptr->n_type == KMAP)
- kmptr = (*map)[ch];
- else
- if (nptr->n_type == SYM)
- {
- keys[kndx] = 0;
- if (sendmsg(nptr,currentenv->n_symvalue,margs.n_ptr) == NULL)
- break;
- kmptr = kmap;
- kndx = 0;
- }
- else
- xlfail("bad keymap");
- }
-
- xlunbind(oldenv); /* unbind */
- xlstack = oldstk; /* Restore old stack frame */
- return (self->n_symvalue); /* and return keymap object */
- }
-
-
- /*******************************************************
- * sendmsg - send a message given an environment list *
- *******************************************************/
-
- static struct node *sendmsg(msym,env,args)
- struct node *msym,*env,*args;
- {
- struct node *eptr,*obj,*msg;
-
- /* look for an object that answers the message */
- for (eptr = env; eptr != NULL; eptr = eptr->n_listnext)
- if ((obj = eptr->n_listvalue) != NULL && obj->n_type == OBJ)
- if ((msg = xlmfind(obj,msym)) != NULL)
- return (xlxsend(obj,msg,args));
-
- /* return the message if no object answered it */
- return (msym);
- }
-
-
- /*****************************
- * xlkmmark - mark a keymap *
- *****************************/
-
- xlkmmark(km)
- struct node *km;
- {
- struct node *(*map)[];
- int i;
-
- km->n_flags |= MARK; /* Mark the keymap node */
-
- if ((map = km->n_kmap) == NULL) /* Check for null keymap */
- return;
-
- for (i = 0; i < KMSIZE; i++) /* Loop through each entry */
- if (((*map)[i] != NULL) && (*map)[i]->n_type == KMAP)
- xlkmmark((*map)[i]);
- }
-
-
- /*****************************
- * xlkmfree - free a keymap *
- *****************************/
-
- xlkmfree(km)
- struct node *km;
- {
- struct node *(*map)[];
- int i;
-
- if ((map = km->n_kmap) == NULL) /* Check for null keymap */
- return;
-
- for (i = 0; i < KMSIZE; i++) /* loop through each entry */
- if (((*map)[i] != NULL) && (*map)[i]->n_type == KMAP)
- xlkmfree((*map)[i]);
-
- free(km->n_kmap); /* and free this one */
- }
-
-
- /******************************************************
- * xlkinit - key map function initialization routine *
- ******************************************************/
-
- xlkinit()
- {
- struct node *keymap;
-
- currentenv = xlenter("currentenv"); /* Define xlisp variables */
-
- keymap = xlclass("Keymap",1); /* Define keymap class */
- xladdivar(keymap,"keymap");
- xladdmsg(keymap,"isnew",isnew);
- xladdmsg(keymap,"key",key);
- xladdmsg(keymap,"process",process);
- }
-
-
- /******************************
- * kbin : fetch a key stroke *
- ******************************/
-
- static kbin()
- {
- #ifdef AZTEC
- return (CPM(6, 0xFF));
- #endif
-
- #ifdef CI_86
- if (bdos(0x0b, 0) & 0xFF == 0xFF)
- return (bdos(0x08, 0));
- return -1;
- #endif
- }